home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / default-dir.el.z / default-dir.el
Encoding:
Text File  |  1998-05-21  |  13.6 KB  |  419 lines
  1. ;;  -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         default-dir.el
  5. ;; RCS:
  6. ;; Version:      #Revision: 1.5 $
  7. ;; Description:  Defines the function default-directory, for fancy handling
  8. ;;               of the initial contents in the minibuffer when reading
  9. ;;               file names.
  10. ;; Authors:      Sebastian Kremer <sk@thp.uni-koeln.de>
  11. ;;               Sandy Rutherford <sandy@ibm550.sissa.it>
  12. ;; Created:      Sun Jul 18 11:38:06 1993 by sandy on ibm550
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;; This program is free software; you can redistribute it and/or modify
  17. ;; it under the terms of the GNU General Public License as published by
  18. ;; the Free Software Foundation; either version 1, or (at your option)
  19. ;; any later version.
  20.  
  21. ;; This program is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. ;; GNU General Public License for more details.
  25.  
  26. ;; You should have received a copy of the GNU General Public License
  27. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  28. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  
  30. (provide 'default-dir)
  31. (require 'efs-ovwrt)
  32.  
  33. (defconst default-dir-emacs-variant
  34.   (cond ((string-match "XEmacs" emacs-version) 'xemacs)
  35.     ((>= (string-to-int (substring emacs-version 0 2)) 19) 'fsf-19)
  36.     (t 'fsf-18)))
  37.  
  38. (defconst default-dir-find-file-takes-coding-system
  39.   (and (eq default-dir-emacs-variant 'xemacs)
  40.        (>= (string-to-int (substring emacs-version 0 2)) 20)))
  41.  
  42. ;;;###autoload
  43. (defvar default-directory-function nil
  44.   "A function to call to compute the default-directory for the current buffer.
  45. If this is nil, the function default-directory will return the value of the
  46. variable default-directory.
  47. Buffer local.")
  48. (make-variable-buffer-local 'default-directory-function)
  49.  
  50. ;; As a bonus we give shell-command history if possible.
  51. (defvar shell-command-history nil
  52.   "History list of previous shell commands.")
  53.  
  54. (defun default-directory ()
  55.   " Returns the default-directory for the current buffer.
  56. Will use the variable default-directory-function if it non-nil."
  57.   (if default-directory-function
  58.       (funcall default-directory-function)
  59.     (if (eq default-dir-emacs-variant 'xemacs)
  60.     (abbreviate-file-name default-directory t)
  61.       (abbreviate-file-name default-directory))))
  62.  
  63. ;;; Overloads
  64.  
  65. (cond
  66.  ((or (featurep 'mule)
  67.       (boundp 'MULE))
  68.  
  69.   (defun default-dir-find-file (file &optional coding-system)
  70.     "Documented as original"
  71.     (interactive   
  72.      (list
  73.       (expand-file-name
  74.        (read-file-name "Find file: " (default-directory)))
  75.       (and current-prefix-arg
  76.        (read-coding-system "Coding-system: "))))
  77.     (default-dir-real-find-file file coding-system))
  78.  
  79.   (defun default-dir-find-file-other-window (file &optional coding-system)
  80.     "Documented as original"
  81.     (interactive
  82.      (list
  83.       (expand-file-name
  84.        (read-file-name "Find file in other window: " (default-directory)))
  85.       (and current-prefix-arg
  86.        (read-coding-system "Coding-system: "))))
  87.     (default-dir-real-find-file-other-window file coding-system))
  88.  
  89.   (defun default-dir-find-file-read-only (file &optional coding-system)
  90.     "Documented as original"
  91.     (interactive
  92.      (list
  93.       (expand-file-name
  94.        (read-file-name "Find file read-only: " (default-directory) nil t))
  95.       (and current-prefix-arg
  96.        (read-coding-system "Coding-system: "))))
  97.     (default-dir-real-find-file-read-only file coding-system))
  98.  
  99.   (if (fboundp 'find-file-read-only-other-window)
  100.       (progn
  101.     (defun default-dir-find-file-read-only-other-window
  102.       (file &optional coding-system)
  103.       "Documented as original"
  104.       (interactive
  105.        (list
  106.         (expand-file-name
  107.          (read-file-name
  108.           "Find file read-only in other window: "
  109.           (default-directory) nil t))
  110.         (and current-prefix-arg
  111.          (read-coding-system "Coding-system: "))))
  112.       (default-dir-real-find-file-read-only-other-window file
  113.         coding-system))))
  114.  
  115.   (if (fboundp 'find-file-other-frame)
  116.       (progn
  117.     (defun default-dir-find-file-other-frame
  118.       (file &optional coding-system)
  119.       "Documented as original"
  120.       (interactive
  121.        (list
  122.         (expand-file-name
  123.          (read-file-name "Find file in other frame: "
  124.                  (default-directory)))
  125.         (and current-prefix-arg
  126.          (read-coding-system "Coding-system: "))))
  127.       (default-dir-real-find-file-other-frame file
  128.         coding-system))))
  129.   
  130.   (if (fboundp 'find-file-read-only-other-frame)
  131.       (progn
  132.     (defun default-dir-find-file-read-only-other-frame
  133.       (file &optional coding-system)
  134.       "Documented as original"
  135.       (interactive
  136.        (list
  137.         (expand-file-name
  138.          (read-file-name "Find file read-only in other frame: "
  139.                  (default-directory) nil t))
  140.         (and current-prefix-arg
  141.          (read-coding-system "Coding-system: "))))
  142.       (default-dir-real-find-file-read-only-other-frame file
  143.         coding-system)))))
  144.  
  145.  (default-dir-find-file-takes-coding-system
  146.    ;; This lossage is due to the fact that XEmacs 20.x without mule
  147.    ;; still accepts an optional argument for find-file related
  148.    ;; functions.  Things like advice.el insist on passing nil for
  149.    ;; optional arguments, and the interaction screws things up.
  150.    ;; Therefore these functions accept an optional dummy coding-system
  151.    ;; argument.
  152.     
  153.    (defun default-dir-find-file (file &optional coding-system)
  154.      "Documented as original"
  155.      (interactive
  156.       (list
  157.        (expand-file-name
  158.     (read-file-name "Find file: " (default-directory)))))
  159.      (default-dir-real-find-file file))
  160.   
  161.    (defun default-dir-find-file-other-window (file &optional coding-system)
  162.      "Documented as original"
  163.      (interactive
  164.       (list
  165.        (expand-file-name
  166.     (read-file-name "Find file in other window: " (default-directory)))))
  167.      (default-dir-real-find-file-other-window file))
  168.  
  169.    (defun default-dir-find-file-read-only (file  &optional coding-system)
  170.      "Documented as original"
  171.      (interactive
  172.       (list
  173.        (expand-file-name
  174.     (read-file-name "Find file read-only: " (default-directory) nil t))))
  175.      (default-dir-real-find-file-read-only file))
  176.   
  177.    (if (fboundp 'find-file-read-only-other-window)
  178.        (progn
  179.      (defun default-dir-find-file-read-only-other-window
  180.        (file  &optional coding-system)
  181.        "Documented as original"
  182.        (interactive
  183.         (list
  184.          (expand-file-name
  185.           (read-file-name
  186.            "Find file read-only in other window: "
  187.            (default-directory) nil t))))
  188.        (default-dir-real-find-file-read-only-other-window file))))
  189.  
  190.    (if (fboundp 'find-file-other-frame)
  191.        (progn
  192.      (defun default-dir-find-file-other-frame
  193.        (file  &optional coding-system)
  194.        "Documented as original"
  195.        (interactive
  196.         (list
  197.          (expand-file-name
  198.           (read-file-name "Find file in other frame: "
  199.                   (default-directory)))))
  200.        (default-dir-real-find-file-other-frame file))))
  201.  
  202.    (if (fboundp 'find-file-read-only-other-frame)
  203.        (progn
  204.      (defun default-dir-find-file-read-only-other-frame
  205.        (file &optional coding-system)
  206.        "Documented as original"
  207.        (interactive
  208.         (list
  209.          (expand-file-name
  210.           (read-file-name "Find file read-only in other frame: "
  211.                   (default-directory) nil t))))
  212.        (default-dir-real-find-file-read-only-other-frame file)))))
  213.  
  214.  (t
  215.     
  216.   (defun default-dir-find-file (file)
  217.     "Documented as original"
  218.     (interactive
  219.      (list
  220.       (expand-file-name
  221.        (read-file-name "Find file: " (default-directory)))))
  222.     (default-dir-real-find-file file))
  223.   
  224.   (defun default-dir-find-file-other-window (file)
  225.     "Documented as original"
  226.     (interactive
  227.      (list
  228.       (expand-file-name
  229.        (read-file-name "Find file in other window: " (default-directory)))))
  230.     (default-dir-real-find-file-other-window file))
  231.  
  232.   (defun default-dir-find-file-read-only (file)
  233.     "Documented as original"
  234.     (interactive
  235.      (list
  236.       (expand-file-name
  237.        (read-file-name "Find file read-only: " (default-directory) nil t))))
  238.     (default-dir-real-find-file-read-only file))
  239.   
  240.   (if (fboundp 'find-file-read-only-other-window)
  241.       (progn
  242.     (defun default-dir-find-file-read-only-other-window (file)
  243.       "Documented as original"
  244.       (interactive
  245.        (list
  246.         (expand-file-name
  247.          (read-file-name
  248.           "Find file read-only in other window: "
  249.           (default-directory) nil t))))
  250.       (default-dir-real-find-file-read-only-other-window file))))
  251.  
  252.   (if (fboundp 'find-file-other-frame)
  253.       (progn
  254.     (defun default-dir-find-file-other-frame (file)
  255.       "Documented as original"
  256.       (interactive
  257.        (list
  258.         (expand-file-name
  259.          (read-file-name "Find file in other frame: "
  260.                  (default-directory)))))
  261.       (default-dir-real-find-file-other-frame file))))
  262.  
  263.   (if (fboundp 'find-file-read-only-other-frame)
  264.       (progn
  265.     (defun default-dir-find-file-read-only-other-frame (file)
  266.       "Documented as original"
  267.       (interactive
  268.        (list
  269.         (expand-file-name
  270.          (read-file-name "Find file read-only in other frame: "
  271.                  (default-directory) nil t))))
  272.       (default-dir-real-find-file-read-only-other-frame file))))))
  273.  
  274.  
  275.  
  276. (efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file)
  277. (efs-overwrite-fn "default-dir" 'find-file-other-window
  278.           'default-dir-find-file-other-window)
  279. (if (fboundp 'find-file-other-frame)
  280.     (efs-overwrite-fn "default-dir" 'find-file-other-frame
  281.               'default-dir-find-file-other-frame))
  282. (efs-overwrite-fn "default-dir" 'find-file-read-only
  283.           'default-dir-find-file-read-only)
  284. (if (fboundp 'find-file-read-only-other-window)
  285.     (efs-overwrite-fn "default-dir" 'find-file-read-only-other-window
  286.               'default-dir-find-file-read-only-other-window))
  287. (if (fboundp 'find-file-read-only-other-frame)
  288.     (efs-overwrite-fn "default-dir" 'find-file-read-only-other-frame
  289.               'default-dir-find-file-read-only-other-frame))
  290.  
  291.  
  292. (defun default-dir-load-file (file)
  293.   "Documented as original"
  294.   (interactive
  295.    (list
  296.     (expand-file-name
  297.      (read-file-name "Load file: " (default-directory) nil t))))
  298.   (default-dir-real-load-file file))
  299.  
  300. (efs-overwrite-fn "default-dir" 'load-file 'default-dir-load-file)
  301.  
  302. (condition-case nil
  303.     (require 'view-less)
  304.   (error (require 'view)))
  305.  
  306. (defun default-dir-view-file (file)
  307.   "Documented as original"
  308.   (interactive
  309.    (list
  310.     (expand-file-name
  311.      (read-file-name "View file: " (default-directory) nil t))))
  312.   (default-dir-real-view-file file))
  313.  
  314. (efs-overwrite-fn "default-dir" 'view-file 'default-dir-view-file)
  315.  
  316. (if (fboundp 'view-file-other-window)
  317.     (progn
  318.       (defun default-dir-view-file-other-window (file)
  319.     "Documented as original"
  320.     (interactive
  321.      (list
  322.       (expand-file-name
  323.        (read-file-name "View file in other window: "
  324.                (default-directory) nil t))))
  325.     (default-dir-real-view-file-other-window file))
  326.       (efs-overwrite-fn "default-dir" 'view-file-other-window
  327.             'default-dir-view-file-other-window)))
  328.  
  329. (if (fboundp 'view-file-other-frame)
  330.     (progn
  331.       (defun default-dir-view-file-other-frame (file)
  332.     "Documented as original"
  333.     (interactive
  334.      (list
  335.       (expand-file-name
  336.        (read-file-name "View file in other frame: "
  337.                (default-directory) nil t))))
  338.     (default-dir-real-view-file-other-frame file))
  339.       (efs-overwrite-fn "default-dir" 'view-file-other-frame
  340.             'default-dir-view-file-other-frame)))
  341.  
  342.  
  343. (defun default-dir-shell-command (command &optional output-buffer)
  344.   "Documented as original"
  345.   (interactive
  346.    (list
  347.     (let ((prompt (format "Shell command in %s: " (default-directory))))
  348.       (cond
  349.        ((eq default-dir-emacs-variant 'xemacs)
  350.     (read-shell-command "Shell command: "))
  351.        ((eq default-dir-emacs-variant 'fsf-19)
  352.     (read-from-minibuffer prompt nil nil nil 'shell-command-history))
  353.        ((featurep 'gmhist)
  354.     (let ((minibuffer-history-symbol 'shell-command-history))
  355.       (read-string prompt)))
  356.        (t (read-string prompt))))
  357.     current-prefix-arg))
  358.   (let ((default-directory (expand-file-name (default-directory))))
  359.     (default-dir-real-shell-command command output-buffer)))
  360.  
  361. (efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command)
  362.  
  363. (defun default-dir-cd (dir)
  364.   "Documented as original"
  365.   (interactive
  366.    (list
  367.     (expand-file-name
  368.      (read-file-name "Change default directory: " (default-directory)))))
  369.   (default-dir-real-cd dir))
  370.   
  371. (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd)
  372.  
  373. (defun default-dir-set-visited-file-name (filename)
  374.   "Documented as original"
  375.   (interactive
  376.    (list
  377.     (expand-file-name
  378.      (read-file-name "Set visited file name: " (default-directory)))))
  379.   (default-dir-real-set-visited-file-name filename))
  380.  
  381. (efs-overwrite-fn "default-dir" 'set-visited-file-name
  382.           'default-dir-set-visited-file-name)
  383.  
  384. (defun default-dir-insert-file (filename &rest args)
  385.   "Documented as original"
  386.   (interactive
  387.    (list
  388.     (expand-file-name
  389.      (read-file-name "Insert file: " (default-directory) nil t))))
  390.   (apply 'default-dir-real-insert-file filename args))
  391.  
  392. (efs-overwrite-fn "default-dir" 'insert-file 'default-dir-insert-file)
  393.  
  394. (defun default-dir-append-to-file (start end filename &rest args)
  395.   "Documented as original"
  396.   (interactive
  397.    (progn
  398.      (or (mark) (error "The mark is not set now"))
  399.      (list
  400.       (min (mark) (point))
  401.       (max (mark) (point))
  402.       (expand-file-name
  403.        (read-file-name "Append to file: " (default-directory))))))
  404.   (apply 'default-dir-real-append-to-file start end filename args))
  405.  
  406. (efs-overwrite-fn "default-dir" 'append-to-file 'default-dir-append-to-file)
  407.  
  408. (defun default-dir-delete-file (file)
  409.   "Documented as original"
  410.   (interactive
  411.    (list
  412.     (expand-file-name
  413.      (read-file-name "Delete file: " (default-directory) nil t))))
  414.   (default-dir-real-delete-file file))
  415.  
  416. (efs-overwrite-fn "default-dir" 'delete-file 'default-dir-delete-file)
  417.  
  418. ;;; end of default-dir.el
  419.